home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d7 / dorpch35.arc / EXAMPLE.BAS < prev    next >
BASIC Source File  |  1989-03-20  |  14KB  |  324 lines
  1. '     $INCLUDE: 'DOORPCH.USR'
  2. 100   PROGNAME$ = "Example"    ' These
  3.       PROGB$ = "EXAMPLE"       '       four
  4.       R.ELEASE$ = "2.3"        '             MUST
  5.       NODE% = 1                '                  be populated
  6. '     $INCLUDE: 'DOORPCH.BEG'  ' CALLs INITIALIZATION code in DORPCH35.EXE
  7.       CLOSE #1                 ' If you had other information within
  8.                                ' DOORPCHn.CFG, you would continue reading
  9.                                ' the file here then CLOSE #1.
  10. '     Detects Alias (read from ENDMON) and installs if Alias name has data in it.
  11.       IF ALIAS.FIRST$ <> "" THEN
  12.          IF ALIAS.LAST$ <> "" THEN
  13.             FIRST$ = ALIAS.FIRST$
  14.             LAST$ = ALIAS.LAST$
  15.          END IF
  16.       END IF
  17.       XPOS% = 5: YPOS% = 1
  18.       CALL OUT.PUT
  19.       FGC% = 5: TBSN% = 23: BLINK% = 1: LN$ = "DOORPCH 3.5": CALL OUT.NCR
  20.       FGC% = 2: LN$ = " demo brought to you by": CALL OUT.PUT
  21.       FGC% = 2: CENTER% = 1: LN$ = "SysOp: " + SYSFIRST$ + " " + SYSLAST$ + " of " + SYSNAME$
  22.       LN$ = LN$ + ", a " + BBSSYS$ + " BBS": CALL OUT.PUT: CALL OUT.PUT
  23.       FGC% = 2: CENTER% = 1: LN$ = "You are about to have a visual demonstration": CALL OUT.PUT
  24.       FGC% = 2: CENTER% = 1: LN$ = "of the capabilities of DOORPCH 3.5 (DOOR PATCH)": CALL COLOR.CHK: CALL OUT.PUT
  25.       FGC% = 2: CENTER% = 1: LN$ = "DOORPCH is simply the BEST door code available": CALL OUT.PUT
  26.       FGC% = 1: BLINK% = 1: CENTER% = 1: LN$ = "PERIOD!": CALL OUT.PUT
  27.       FGC% = 2: CENTER% = 1: LN$ = "Many more capabilities exist than displayed here": CALL OUT.PUT
  28.       FGC% = 2: CENTER% = 1: LN$ = "Give it a whirl. If you find a function not": CALL OUT.PUT
  29.       FGC% = 2: CENTER% = 1: LN$ = "provided by DOORPCH, simply contact one of our": CALL OUT.PUT
  30.       FGC% = 2: CENTER% = 1: LN$ = "BBS's and give us your requirements . . . .": CALL OUT.PUT
  31.       CALL OUT.PUT
  32.       CALL ENTER
  33. 120   DO
  34.            CALL CLR.SCRN
  35.            FGC% = 5: LN$ = "Example DOOR Menu": CENTER% = 1: CALL OUT.PUT
  36.            FGC% = 7: LN$ = "=================": CENTER% = 1: CALL OUT.PUT
  37.            XPOS% = 5: YPOS% = 1: FGC% = 2: LN$ = "Select one of the following examples:": CALL OUT.PUT
  38.            CALL OUT.PUT
  39.            FGC% = 6: LN$ = "[1]  -  Music Output": CALL COLOR.CHK: CALL OUT.NCR
  40.            IF NETWORK% = 1 AND LOCALX = 1 THEN LN$ = ", unavailable in NETWORK LOCAL mode"
  41.            CALL OUT.PUT
  42.            FGC% = 6: LN$ = "[2]  -  Screen Positioning": CALL COLOR.CHK: CALL OUT.PUT
  43.            FGC% = 6: LN$ = "[3]  -  High Scores": CALL COLOR.CHK: CALL OUT.PUT
  44.            FGC% = 6: LN$ = "[4]  -  Centering output": CALL COLOR.CHK: CALL OUT.PUT
  45.            FGC% = 6: LN$ = "[5]  -  SUBS: COLOR.CHK, GET.KEY, GET.KEYECHO": CALL COLOR.CHK: CALL OUT.PUT
  46.            FGC% = 6: LN$ = "              IN.PUT, OUT.PUT and ENTER": CALL OUT.PUT
  47.            FGC% = 6: LN$ = "[6]  -  Cursor positioning with SUB GET.KEY": CALL COLOR.CHK: CALL OUT.PUT
  48.            FGC% = 6: LN$ = "[7]  -  Read Graphics files / menus from disk !": CALL COLOR.CHK: CALL OUT.PUT
  49.            FGC% = 6: LN$ = "[8]  -  Make those fancy prompts !": CALL COLOR.CHK: CALL OUT.PUT
  50.            FGC% = 6: LN$ = "[9]  -  Exit and Return to System or Monitor": CALL COLOR.CHK
  51.            CALL OUT.PUT: CALL OUT.PUT
  52.            FGC% = 2: LN$ = "(" + MID$(STR$(DMIN%),2) + " min. left) Enter Selection, " + FIRST$ + " ? ": CALL COLOR.CHK: CALL IN.PUT
  53.            IF ARG$ = "" THEN GOTO 120
  54.            SEL = VAL(ARG$)
  55.            SELECT CASE SEL
  56.                CASE  9
  57.                   CALL CLR.SCRN
  58.                   FGC% = 1: CENTER% = 1: LN$ = "Thanks for testing " + PROGNAME$: CALL OUT.PUT
  59.                   FGC% = 2: CENTER% = 1: LN$ = "Now try your hand at writing DOOR's": CALL OUT.PUT
  60.                   FGC% = 3: CENTER% = 1: LN$ = "Its really very easy as you can see": CALL OUT.PUT
  61.                   CALL OUT.PUT:CALL OUT.PUT
  62.                   FGC% = 6: LN$ = "DOORPCH 3.5 Authors": CENTER% =1: CALL OUT.PUT: CALL OUT.PUT
  63.                   FGC% = 3: LN$ = "Clint Labarthe, Black Hole BBS,  (407) 260-6397": CENTER% =1: CALL OUT.PUT
  64.                   FGC% = 3: LN$ = "Terry Shockley, Death Star BBS,  (407) 875-4123": CENTER% =1: CALL OUT.PUT
  65.                   FGC% = 1: LN$ = "Assembler programming by Harold Thomson": CENTER% =1: CALL OUT.PUT: CALL OUT.PUT
  66.                   CALL OUT.PUT
  67.                   EXIT DO
  68.                CASE 1 TO 8
  69.                   ON SEL GOSUB 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800
  70.                CASE ELSE
  71.            END SELECT
  72.       LOOP UNTIL SEL = 9
  73. '     END OF MAIN LOOP
  74.       CALL EXITG  ' Never come back. DOOR terminates in DOORPCH code
  75.  
  76. ' Music example
  77. 1100
  78.       CALL CLR.SCRN
  79.       FGC% = 5: LN$ = "Music Output Example": CENTER% = 1: CALL OUT.PUT
  80.       FGC% = 7: LN$ = "====================": CENTER% = 1: CALL OUT.PUT
  81.       CALL OUT.PUT
  82.       CALL OUT.PUT
  83.       FGC% = 2: LN$ = "Can your system handle music [y/N] ? ": CALL COLOR.CHK
  84.       CALL IN.PUT
  85.       IF MID$(ARG$, 1, 1) <> "Y" THEN RETURN
  86.       CALL OUT.PUT
  87.       LN$ = "ALOYTTE"
  88.       CALL OUT.PUT
  89.       MUSIC$ = "L4E.L8F#L4G#G#L8F#EF#G#L4EO1BO2E.L8F#L4G#G#L8F#EF#G#L2EL8EF#G#ABBL4BL8BO3C#O2BAG#F#L4EL8BBL4BO1L8BBL4BO2L8BBL4BO1L8BBL4BO2L1BL4E.L8F#L4G#G#L8F#EF#G#L4EO1BO2E.L8F#L4G#G#  L4F#EF#G#L2E"
  90.       CALL MUSICG
  91.       CALL OUT.PUT
  92.       CALL OUT.PUT
  93.       CALL MORE
  94.       CALL OUT.PUT
  95.       IF MID$(ARG$, 1, 1) <> "E" THEN
  96.          LN$ = "TOM DOOLEY"
  97.          CALL OUT.PUT
  98.          MUSIC$ = "L4DDEGBL2BL4BDDEGL1AL4DDEGAL2A.L8AAAAL4GEL2G.P4L8DL4DL8DL4EGL2BBL8DL4DL8EL4GL1AL8DL4DL8DL4EGL2AAL8AL4AL8BL4GEL2G"
  99.       END IF
  100.       CALL MUSICG
  101.       CALL OUT.PUT
  102.       CALL ENTER
  103.       RETURN
  104.  
  105. ' Screen Positioning Example
  106. 1200  CALL CLR.SCRN
  107.       FGC% = 5: LN$ = "ANSI Screen Positioning Example": CENTER% = 1: CALL OUT.PUT
  108.       FGC% = 7: LN$ = "===============================": CENTER% = 1: CALL OUT.PUT
  109. 1210  ' The right side of the box
  110.       FOR X = 16 TO 4 STEP -1
  111.       XPOS% = X
  112.       YPOS% = 3
  113.       LN$ = CHR$(186)
  114.       CALL OUT.NCR
  115.       NEXT X
  116. ' The corner of the box left top
  117.       XPOS% = 3
  118.       YPOS% = 3
  119.       LN$ = CHR$(201)
  120.       CALL OUT.NCR
  121. ' The top of the box
  122.       FOR X = 4 TO 77
  123.       XPOS% = 3
  124.       YPOS% = X
  125.       LN$ = CHR$(205)
  126.       CALL OUT.NCR
  127.       NEXT X
  128. ' top right corner
  129.       XPOS% = 3
  130.       YPOS% = 78
  131.       LN$ = CHR$(187)
  132.       CALL OUT.NCR
  133. ' right side
  134.       FOR X = 4 TO 16
  135.       XPOS% = X
  136.       YPOS% = 78
  137.       LN$ = CHR$(186)
  138.       CALL OUT.NCR
  139.       NEXT X
  140. ' The bottom right side corner
  141.       XPOS% = 17
  142.       YPOS% = 78
  143.       LN$ = CHR$(188)
  144.       CALL OUT.NCR
  145. ' The bottom of the box
  146.       FOR X = 77 TO 4 STEP -1
  147.       XPOS% = 17
  148.       YPOS% = X
  149.       LN$ = CHR$(205)
  150.       CALL OUT.NCR
  151.       NEXT X
  152. ' left side corner bottom
  153.       YPOS% = 3
  154.       XPOS% = 17
  155.       LN$ = CHR$(200)
  156.       CALL OUT.NCR
  157.       XPOS% = 18
  158.       YPOS% = 1
  159.       CALL OUT.PUT
  160.       IF SEL = 2 THEN
  161.          XPOS% = 9: YPOS% = 20: FGC% = 5 ' Set coordinates and magenta color
  162.          LN$ = "Almost anything is possible with ": CALL OUT.NCR
  163.          FGC% = 7
  164.          LN$ = "DOORPCH !": CALL OUT.PUT
  165.          XPOS% = 19
  166.          YPOS% = 1
  167.          CALL OUT.NCR
  168.          CALL ENTER
  169.       END IF
  170.       RETURN
  171.  
  172. ' High Scores Example
  173. 1300
  174.       CALL CLR.SCRN
  175.       FGC% = 7: LN$ = "High Scores Example": CENTER% = 1: CALL OUT.PUT
  176.       LN$ = "===================": CENTER% = 1: CALL OUT.PUT
  177.       CALL OUT.PUT
  178.       FGC% = 5: BLINK% = 1: LN$ = "Selecting a score randomly . . .": CALL OUT.NCR
  179.       HSCR# = INT(RND * 1000 + 1)
  180.       LN$ = " the score selected is " + STR$(HSCR#): CALL OUT.PUT
  181.       CALL OUT.PUT
  182.       CALL HIGH.SCORE
  183.       RETURN
  184. 1400 'Centering example
  185.       CALL CLR.SCRN: XPOS% = 10: YPOS% = 1 ' Row 10, Column 01
  186.       LN$ = "This text is centered": CENTER% = 1: CALL OUT.PUT: CALL OUT.PUT
  187.       CALL ENTER
  188.       RETURN
  189. 1500 'Example of how SUB COLOR.CHK operates
  190.       CALL CLR.SCRN
  191. 1501  FGC% = 6: LN$ = "This example requires pressing RETURN": CALL OUT.PUT: CALL OUT.PUT
  192.       FGC% = 3: LN$ = "It also": CALL OUT.NCR
  193.       FGC% = 1: LN$ = " ECHO's ": CALL OUT.NCR
  194.       FGC% = 3: LN$ = "the character": CALL OUT.PUT:CALL OUT.PUT
  195.       FGC% = 2: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ": CALL COLOR.CHK: CALL IN.PUT
  196.       IF ARG$ = "P" OR ARG$ = "Q" OR ARG$ = "C" THEN ELSE 1501
  197.       CALL OUT.PUT: CALL OUT.PUT
  198.       FGC% = 5: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT:CALL OUT.PUT: CALL ENTER
  199. 1502  CALL CLR.SCRN: FGC% = 6: LN$ = "You can also get a character WITHOUT a RETURN": CALL OUT.PUT: CALL OUT.PUT
  200.       FGC% = 3: LN$ = "It also": CALL OUT.NCR
  201.       FGC% = 1: LN$ = " ECHO's ": CALL OUT.NCR
  202.       FGC% = 3: LN$ = "the character": CALL OUT.PUT:CALL OUT.PUT
  203.       FGC% = 2: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ":CALL COLOR.CHK: CALL GET.KEYECHO
  204.       IF ARG$ = "P" OR ARG$ = "Q" OR ARG$ = "C" THEN ELSE 1502
  205.       CALL OUT.PUT:CALL OUT.PUT
  206.       FGC% = 5: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT: CALL OUT.PUT:CALL ENTER
  207. 1503  CALL CLR.SCRN: FGC% = 6: LN$ = "This example does NOT require pressing RETURN": CALL OUT.PUT:CALL OUT.PUT
  208.       FGC% = 3: LN$ = "It also": CALL OUT.NCR
  209.       FGC% = 1: LN$ = " DOES NOT ECHO ": CALL OUT.NCR
  210.       FGC% = 3: LN$ = "the character": CALL OUT.PUT:CALL OUT.PUT
  211.       FGC% = 2: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ":CALL COLOR.CHK: CALL GET.KEY
  212.       IF ARG$ = "P" OR ARG$ = "Q" OR ARG$ = "C" THEN ELSE 1503
  213.       CALL OUT.PUT: CALL OUT.PUT
  214.       FGC% = 5: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT:CALL OUT.PUT: CALL ENTER
  215. 1504  CALL CLR.SCRN: FGC% = 6: LN$ = "This example requires pressing RETURN": CALL OUT.PUT: CALL OUT.PUT
  216.       FGC% = 3: LN$ = "It also": CALL OUT.NCR
  217.       FGC% = 1: LN$ = " ECHO's ": CALL OUT.NCR
  218.       FGC% = 3: LN$ = "the character": CALL OUT.PUT:CALL OUT.PUT
  219.       FGC% = 7: LN$ = "Oh so you expect LOWER case ?": CALL OUT.PUT:CALL OUT.PUT
  220.       FGC% = 2: RETURNCASE% = -1:LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ": CALL COLOR.CHK: CALL IN.PUT
  221.       IF ARG$ = "p" OR ARG$ = "q" OR ARG$ = "c" THEN ELSE 1504
  222.       CALL OUT.PUT
  223.       CALL OUT.PUT
  224.       FGC% = 5: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT:CALL OUT.PUT: CALL ENTER
  225.       CALL CLR.SCRN: XPOS% = 9: YPOS% = 10: FGC% = 6: LN$ = "So you want more than one ": CALL OUT.NCR
  226.       FGC% = 3: LN$ = "color": CALL OUT.NCR
  227.       FGC% = 6: LN$ = " on same line, and a BELL too!": BELL% = 1: CALL OUT.PUT:CALL OUT.PUT
  228.       CALL OUT.PUT:CALL ENTER ' Gives the caller an ENTER prompt
  229.       RETURN
  230.  
  231. 1600  CALL CLR.SCRN
  232.       FGC% = 5: LN$ = "ANSI Cursor Positioning Example": CENTER% = 1: CALL OUT.PUT
  233.       FGC% = 7: LN$ = "===============================": CENTER% = 1: CALL OUT.PUT
  234.       GOSUB 1210
  235.       BOUNDLEFT = 4: BOUNDRIGHT = 77
  236.       BOUNDBOTTOM = 16: BOUNDTOP = 4
  237.       LN$ = "Press NUM-LOCK then press"
  238.       XPOS% = 18: YPOS% = 1: CENTER% = 1: CALL OUT.PUT
  239.       LN$ = "(8) for UP, (6) for RIGHT, (2) for DOWN and (4) for LEFT": CENTER% = 1: CALL COLOR.CHK
  240.       CALL OUT.PUT
  241.       LN$ = "(5) to EXIT, <ENTER> to place an `X'": CENTER% = 1: CALL COLOR.CHK
  242.       CALL OUT.PUT
  243.       XPOS% = 21: YPOS% = 1: CALL OUT.PUT
  244.       CALL ENTER
  245.       XPOS% = 8: TEMPX% = XPOS%: YPOS% = 39: TEMPY% = YPOS%: CALL OUT.NCR
  246. 1610  DO
  247.          CALL GET.KEY
  248.          SELECT CASE LEFT$(ARG$,1)
  249.              CASE "8"
  250.                   TEMPX% = TEMPX% - 1
  251.                   GOSUB RANGE
  252.              CASE "6"
  253.                   TEMPY% = TEMPY% + 1
  254.                   GOSUB RANGE
  255.              CASE "2"
  256.                   TEMPX% = TEMPX% + 1
  257.                   GOSUB RANGE
  258.              CASE "4"
  259.                   TEMPY% = TEMPY% - 1
  260.                   GOSUB RANGE
  261.              CASE "5"  'Just a place to end this routine for testing
  262.                   EXIT DO
  263.              CASE ELSE
  264.                   IF LEFT$(ARG$,1) = CHR$(13) THEN
  265.                      XPOS% = TEMPX%: YPOS% = TEMPY%
  266.                      LN$ = "X": CALL OUT.NCR
  267.                      XPOS% = TEMPX%: YPOS% = TEMPY%
  268.                      LN$ = "": CALL OUT.NCR
  269.                   END IF
  270.          END SELECT
  271.       LOOP
  272.       RETURN
  273. RANGE:
  274.          IF TEMPY% > BOUNDRIGHT THEN TEMPY% = 4
  275.          IF TEMPY% < BOUNDLEFT THEN TEMPY% = 77
  276.          IF TEMPX% > BOUNDBOTTOM THEN TEMPX% = 4
  277.          IF TEMPX% < BOUNDTOP THEN TEMPX% = 16
  278.          XPOS% = TEMPX%: YPOS% = TEMPY%: LN$ = "": CALL OUT.NCR
  279.          RETURN
  280. 1700  CALL CLR.SCRN
  281.       LN$ = "You can even read graphics screens or menus from disk !"
  282.       CENTER% = 1: CALL OUT.PUT
  283.       CALL READ.TXT("EXAMPLE.SCR") 'Graphics mode will read <filename>G.SCR
  284.       CALL ENTER
  285.       RETURN
  286. 1800  CALL CLR.SCRN
  287.       CENTER% = 1
  288.       LN$ = "You can now make those fancy prompts without getting a headache. . ."
  289.       CALL OUT.PUT
  290.       XPOS% = 5: YPOS% = 1
  291.       CENTER% = 1
  292.       FGC% = 2
  293.       LN$ = "[T]rains, [P]lanes and [A]utomobiles"
  294.       CALL COLOR.CHK
  295.       CALL OUT.PUT: CALL OUT.PUT
  296.       CENTER% = 1
  297.       FGC% = 7
  298.       LN$ = "or ....": CALL OUT.PUT
  299.       XPOS% = 9: YPOS% = 1: CENTER% = 1
  300.       FGC% = 6
  301.       LN$ = "Select a category: <a,b,c,d> or [q]uit or <Q>uit or [1,2,3,Q,g,x]"
  302.       CALL COLOR.CHK
  303.       CALL OUT.PUT: CALL OUT.PUT
  304.       CENTER% = 1
  305.       FGC% = 7
  306.       LN$ = "or ....": CALL OUT.PUT
  307.       FGC% = 3
  308.       XPOS% = 13: YPOS% = 1: CENTER% = 1
  309.       LN$ = "<CAPITAL LETTERS get one color, 123456 get another, lower case another>"
  310.       CALL COLOR.CHK
  311.       CALL OUT.PUT: CALL OUT.PUT: CALL OUT.PUT
  312.       XPOS% =18: YPOS% = 29
  313.       FGC% = 5
  314.       LN$ = "DOORPCH makes it "
  315.       CALL OUT.NCR
  316.       BLINK% = 1
  317.       FGC% = 5
  318.       LN$ = "easy!"
  319.       CALL OUT.PUT: CALL OUT.PUT
  320.       XPOS% =23: YPOS% = 1
  321.       CALL ENTER
  322.       RETURN
  323. '     $INCLUDE: 'DOORPCH.END'
  324.